home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / magicvdi.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  36.4 KB  |  1,400 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *         MAGIC   Modula's  All purpose  GEM  Interface  Cadre         *
  4.  *                 ÿ         ÿ            ÿ    ÿ          ÿ             *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus in schrift-  *
  11.  * licher Form, insbesondere in Zeitschriften, sowie die Verbreitung    *
  12.  * ber Public-Domain-H„ndler bedarf der ausdrcklichen schriftlichen   *
  13.  * Genehmigung des Autors!                                              *
  14.  *                                                                      *
  15.  * Der Autor gibt hiermit die ausdrckliche Erlaubnis, das Modul jeder- *
  16.  * zeit auch im Quelltext weiterzugegeben, sofern dessen Text und ins-  *
  17.  * besondere dieser Urheberrechts-Vermerk nicht ver„ndert wird, und     *
  18.  * durch die Weitergabe kein finanzieller Nutzen entsteht. Der Autor    *
  19.  * beh„lt sich das Recht vor, diese Erlaubnis jederzeit u. ohne Angaben *
  20.  * von Grnden zu widerrufen.                                           *
  21.  *----------------------------------------------------------------------*)
  22.  
  23. IMPLEMENTATION MODULE MagicVDI;
  24.  
  25. (*----------------------------------------------------------------------*
  26.  * Int. Vers | Datum    | Name | Žnderung                               *
  27.  *-----------+----------+------+----------------------------------------*
  28.  *  3.00     | 18.01.92 |  Hp  |                                        *
  29.  *  3.01     | 29.01.92 |  Hp  | Routinen optimiert                     *
  30.  *-----------+----------+------+----------------------------------------*)
  31.  
  32.  
  33.  
  34. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  35. (*                                              *)
  36. (*$R-   Range-Checks                            *)
  37. (*$S-   Stack-Check                             *)
  38. (*                                              *)
  39. (*----------------------------------------------*)
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  47.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  48.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  49.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  50.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  51.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  52.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  53.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60. IMPORT SYSTEM, MagicSys;
  61.  
  62. VAR array: POINTER TO ARRAY [0..MAX(INTEGER)] OF sINTEGER;
  63.     vdipb: SYSTEM.ADDRESS;  (* Adresse des VDI-Parameterblocks *)
  64.  
  65.  
  66. PROCEDURE VDICall (c0, c1, c3, c5, c6: sINTEGER);
  67. BEGIN
  68.  VDIControl[0]:= c0;
  69.  VDIControl[1]:= c1;
  70.  VDIControl[3]:= c3;
  71.  VDIControl[5]:= c5;
  72.  VDIControl[6]:= c6;
  73.  MagicSys.CallGEM (115, vdipb);
  74. END VDICall;
  75.  
  76. PROCEDURE fillIntin (REF string: ARRAY OF CHAR; VAR adr: SYSTEM.ADDRESS; VAR len: sINTEGER);
  77. (* Fllt das IntIn-Array, alloziert ggf. einen neuen Speicherblock
  78.  * dafr und gibt die Adresse zurck 
  79.  *)
  80.  VAR h : sCARDINAL;
  81.      c : sCARDINAL;
  82.      a : SYSTEM.ADDRESS;
  83. BEGIN
  84.  h:= HIGH(string);
  85.  SYSTEM.ASSEMBLER
  86.    MOVEQ        #0,D0
  87.    MOVE.W       h(A6),D1
  88.    MOVEQ        #0,D2
  89.    MOVE.L       string(A6),A0
  90.    LEA          VDIIntIn,A1
  91.    MOVE.L       A1,a(A6)
  92.  loop:
  93.    MOVE.B       (A0)+,D2
  94.    MOVE.W       D2,(A1)+
  95.    BEQ.S        exit
  96.    ADDQ.W       #1,D0
  97.    CMPI.W       #511,D0     (* VDIIntIn voll? *)
  98.    BEQ.S        mist        (* BEQ, da die Schleife auch sp„ter wieder angesprungen wird, wenn D0 gr”žer ist! *)
  99.    SUBQ.W       #1,D1
  100.    BNE.S        loop
  101.   exit:
  102.    BRA.S        end
  103.   mist:
  104.    ; Jetzt erstmal die L„nge feststellen 
  105.    MOVE.L       A0,A2
  106.    MOVE.W       D0,D2
  107.   lm:
  108.    ADDQ.W       #1,D2
  109.    TST.B        (A2)+
  110.    BNE.S        lm
  111.   lmend:
  112.    ; L„nge steht nun in D2
  113.    ; Speicher fr neues VDIIntIn beim GEMDOS anfordern 
  114.    MOVEM.L      D0-D1/A0-A1/A3-A6,-(SP)
  115.    LSL.W        #1,D2           ; * 2 fr Integer
  116.    MOVE.L       D2,-(SP)
  117.    MOVE.W       #72, -(SP)
  118.    TRAP         #1
  119.    ADDQ.L       #6, SP
  120.    MOVE.L       D0,A2
  121.    BEQ.S        fail            ; kein Speicher mehr frei! Wir machen ganu normal weiter
  122.    MOVE.L       D0,a(A6)
  123.    MOVEM.L      (SP)+,D0-D1/A0-A1/A3-A6
  124.    ; Jetzt VDIIntIn nochmal kopieren
  125.    LEA          VDIIntIn,A1
  126.    MOVE.W       D0,D2
  127.    EXT.L        D2
  128.    SUBQ.W       #1,D2
  129.   lm2:
  130.    MOVE.W       (A1)+,(A2)+
  131.    DBRA         D2, lm2
  132.    ; So, jetzt ist das Array kopiert. 
  133.    ; Jetzt mssen wir noch ein paar Register wiederherstellen und k”nnen dann in Loop
  134.    ; weitermachen
  135.    MOVE.L       A2,A1
  136.   fail:
  137.    MOVEQ        #0,D2
  138.    SUBQ.W       #1,D1
  139.    BNE.S        loop
  140.   end:
  141.    MOVE.W       D0,c(A6)
  142.  END;
  143.  adr := a;
  144.  len := c;
  145. END fillIntin;
  146.  
  147. PROCEDURE freeIntin (a: SYSTEM.ADDRESS);
  148. BEGIN
  149.  SYSTEM.ASSEMBLER
  150.    LEA      VDIIntIn,A0
  151.    MOVE.L   a(A6),A1
  152.    CMPA.L   A0,A1
  153.    BEQ.S    exit
  154.    ; Mfree fr a aufrufen
  155.    MOVE.L  A1, -(SP)
  156.    MOVE.W  #73, -(SP)
  157.    TRAP    #1
  158.    ADDQ.L  #6, SP
  159.   exit:
  160.  END;
  161.  VDIPB.intin := SYSTEM.ADR(VDIIntIn);
  162. END freeIntin;
  163.  
  164. PROCEDURE VqGdos(): lCARDINAL;
  165. BEGIN
  166.  RETURN MagicSys.VqGdos ();
  167. END VqGdos;
  168.  
  169. PROCEDURE SetWritemode (handle, mode: sINTEGER): sINTEGER;
  170. BEGIN
  171.  VDIIntIn[0]:= mode;
  172.  VDICall (32, 0, 1, 0, handle);
  173.  RETURN VDIIntOut[0];
  174. END SetWritemode;
  175.  
  176. PROCEDURE SetColor (handle, index: sINTEGER; VAR rgb: ARRAY OF LOC);
  177. BEGIN
  178.  VDIIntIn[0]:= index;
  179.  array:= SYSTEM.ADR (rgb);
  180.  VDIIntIn[1]:= array^[0];
  181.  VDIIntIn[2]:= array^[1];
  182.  VDIIntIn[3]:= array^[2];
  183.  VDICall(14, 0, 4, 0, handle);
  184. END SetColor;
  185.  
  186. PROCEDURE SetLinetype (handle, style: sINTEGER): sINTEGER;
  187. BEGIN
  188.  VDIIntIn[0]:= style;
  189.  VDICall (15, 0, 1, 0, handle);
  190.  RETURN VDIIntOut[0];
  191. END SetLinetype;
  192.  
  193. PROCEDURE SetUserlinestyle (handle: sINTEGER; REF style: ARRAY OF LOC);
  194. BEGIN
  195.  VDIIntIn[0]:= CastToInt (style);
  196.  VDICall (113, 0, 1, 0, handle);
  197. END SetUserlinestyle;
  198.  
  199. PROCEDURE SetLinewidth (handle, width: sINTEGER): sINTEGER;
  200. BEGIN
  201.  VDIPtsIn[0]:= width;
  202.  VDIPtsIn[1]:= 0;
  203.  VDICall (16, 1, 0, 0, handle);
  204.  RETURN VDIPtsOut[0];
  205. END SetLinewidth;
  206.  
  207. PROCEDURE SetLinecolor (handle, color: sINTEGER): sINTEGER;
  208. BEGIN
  209.  VDIIntIn[0]:= color;
  210.  VDICall (17, 0, 1, 0, handle);
  211.  RETURN VDIIntOut[0];
  212. END SetLinecolor;
  213.  
  214. PROCEDURE SetLineEndstyles (handle, begin, end: sINTEGER);
  215. BEGIN
  216.  VDIIntIn[0]:= begin;
  217.  VDIIntIn[1]:= end;
  218.  VDICall (108, 0, 2, 0, handle);
  219. END SetLineEndstyles;
  220.  
  221. PROCEDURE SetMarkertype (handle, type: sINTEGER): sINTEGER;
  222. BEGIN
  223.  VDIIntIn[0]:= type;
  224.  VDICall (18, 0, 1, 0, handle);
  225.  RETURN VDIIntOut[0];
  226. END SetMarkertype;
  227.  
  228. PROCEDURE SetMarkerheight (handle, height: sINTEGER): sINTEGER; 
  229. BEGIN
  230.  VDIPtsIn[0]:= height;
  231.  VDIPtsIn[1]:= 0;
  232.  VDICall (19, 1, 0, 0, handle);
  233.  RETURN VDIPtsOut[0];
  234. END SetMarkerheight;
  235.  
  236. PROCEDURE SetMarkercolor (handle, index: sINTEGER): sINTEGER;
  237. BEGIN
  238.  VDIIntIn[0]:= index;
  239.  VDICall (20, 0, 1, 0, handle);
  240.  RETURN VDIIntOut[0];
  241. END SetMarkercolor;
  242.  
  243. PROCEDURE SetCharheight (handle, hi: sINTEGER; VAR cw, ch, bw, bh: sINTEGER);
  244. BEGIN
  245.  VDIPtsIn[0]:= 0;
  246.  VDIPtsIn[1]:= hi;
  247.  VDICall (12, 1, 0, 0, handle);
  248.  cw:= VDIPtsOut[0];
  249.  ch:= VDIPtsOut[1];
  250.  bw:= VDIPtsOut[2];
  251.  bh:= VDIPtsOut[3];
  252. END SetCharheight;
  253.  
  254. PROCEDURE SetCharpoints (handle, hi: sINTEGER; VAR cw, ch, bw, bh: sINTEGER): sINTEGER;
  255. BEGIN
  256.  VDIIntIn[0]:= hi;
  257.  VDICall (107, 0, 1, 0, handle);
  258.  cw:= VDIPtsOut[0];
  259.  ch:= VDIPtsOut[1];
  260.  bw:= VDIPtsOut[2];
  261.  bh:= VDIPtsOut[3];
  262.  RETURN VDIIntOut[0];
  263. END SetCharpoints;
  264.  
  265. PROCEDURE SetCharbaseline (handle, angle: sINTEGER): sINTEGER;
  266. BEGIN
  267.  VDIIntIn[0]:= angle;
  268.  VDICall (13, 0, 1, 0, handle);
  269.  RETURN VDIIntOut[0];
  270. END SetCharbaseline;
  271.  
  272. PROCEDURE SetTextface (handle, font: sINTEGER): sINTEGER;
  273. BEGIN
  274.  VDIIntIn[0]:= font;
  275.  VDICall (21, 0, 1, 0, handle);
  276.  RETURN VDIIntOut[0];
  277. END SetTextface;
  278.  
  279. PROCEDURE SetTextcolor (handle, index: sINTEGER): sINTEGER;
  280. BEGIN
  281.  VDIIntIn[0]:= index;
  282.  VDICall (22, 0, 1, 0, handle);
  283.  RETURN VDIIntOut[0];
  284. END SetTextcolor;
  285.  
  286. PROCEDURE SetTexteffect (handle: sINTEGER; effect: sBITSET): sBITSET;
  287. BEGIN
  288.  VDIIntIn[0]:= CastToInt (effect);
  289.  VDICall (106, 0, 1, 0, handle);
  290.  RETURN CastToBitset (VDIIntOut[0]);
  291. END SetTexteffect;
  292.  
  293. PROCEDURE SetTextalignment (handle, hin, vin: sINTEGER; VAR ho, vo: sINTEGER);
  294. BEGIN
  295.  VDIIntIn[0]:= hin;
  296.  VDIIntIn[1]:= vin;
  297.  VDICall (39, 0, 2, 0, handle);
  298.  ho:= VDIIntOut[0];
  299.  vo:= VDIIntOut[1];
  300. END SetTextalignment;
  301.  
  302. PROCEDURE SetFillinterior (handle, index: sINTEGER): sINTEGER;
  303. BEGIN
  304.  VDIIntIn[0]:= index;
  305.  VDICall (23, 0, 1, 0, handle);
  306.  RETURN VDIIntOut[0];
  307. END SetFillinterior;
  308.  
  309. PROCEDURE SetFillstyle (handle, style: sINTEGER): sINTEGER;
  310. BEGIN
  311.  VDIIntIn[0]:= style;
  312.  VDICall (24, 0, 1, 0, handle);
  313.  RETURN VDIIntOut[0];
  314. END SetFillstyle;
  315.  
  316. PROCEDURE SetFillcolor (handle, index: sINTEGER): sINTEGER; 
  317. BEGIN
  318.  VDIIntIn[0]:= index;
  319.  VDICall (25, 0, 1, 0, handle);
  320.  RETURN VDIIntOut[0];
  321. END SetFillcolor;
  322.  
  323. PROCEDURE SetFillperimeter (handle: sINTEGER; border: BOOLEAN): BOOLEAN;
  324. BEGIN
  325.  IF border THEN  VDIIntIn[0]:= 1;  ELSE  VDIIntIn[0]:= 0;  END;
  326.  VDICall (104, 0, 1, 0, handle);
  327.  RETURN VDIIntOut[0] = 1;
  328. END SetFillperimeter;
  329.  
  330. PROCEDURE SetUserfillpattern (handle: sINTEGER; VAR pat: ARRAY OF LOC;
  331.                               planes: sINTEGER);
  332. VAR old: SYSTEM.ADDRESS;
  333. BEGIN
  334.  old:= VDIPB.intin;
  335.  VDIPB.intin:= SYSTEM.ADR (pat);
  336.  VDICall (112, 0, planes * 16, 0, handle);
  337.  VDIPB.intin:= old;
  338. END SetUserfillpattern;
  339.  
  340. PROCEDURE OpenWorkstation (VAR in: ARRAY OF LOC; VAR handle: sINTEGER;
  341.                            VAR out: ARRAY OF LOC);
  342. VAR c: sINTEGER;
  343. BEGIN
  344.  array:= SYSTEM.ADR (in);
  345.  FOR c:= 0 TO 10 DO  VDIIntIn[c]:= array^[c]; END;
  346.  VDICall(1, 0, 11, 0, handle);
  347.  handle:= VDIControl[6];
  348.  array:= SYSTEM.ADR (out);
  349.  FOR c:= 0 TO 44 DO  array^[c]:= VDIIntOut[c]; END;
  350.  FOR c:= 0 TO 11 DO  array^[c+44]:= VDIPtsOut[c]; END;
  351. END OpenWorkstation;
  352.  
  353. PROCEDURE CloseWorkstation (handle: sINTEGER);
  354. BEGIN
  355.  VDICall(2, 0, 0, 0, handle);
  356. END CloseWorkstation;
  357.  
  358. PROCEDURE OpenVirtual (VAR in: ARRAY OF LOC; VAR handle: sINTEGER;
  359.                        VAR out: ARRAY OF LOC);
  360. VAR c: sINTEGER;
  361. BEGIN
  362.  array:= SYSTEM.ADR (in);
  363.  FOR c:= 0 TO 10 DO  VDIIntIn[c]:= array^[c]; END;
  364.  VDICall(100, 0, 11, 0, handle);
  365.  handle:= VDIControl[6];
  366.  array:= SYSTEM.ADR (out);
  367.  FOR c:= 0 TO 44 DO  array^[c]:= VDIIntOut[c]; END;
  368.  FOR c:= 0 TO 11 DO  array^[c+45]:= VDIPtsOut[c]; END;
  369. END OpenVirtual;
  370.  
  371. PROCEDURE CloseVirtual (handle: sINTEGER);
  372. BEGIN
  373.  VDICall(101, 0, 0, 0, handle);
  374. END CloseVirtual;
  375.  
  376. PROCEDURE ClearWorkstation (handle: sINTEGER);
  377. BEGIN
  378.  VDICall(3, 0, 0, 0, handle);
  379. END ClearWorkstation;
  380.  
  381. PROCEDURE UpdateWorkstation (handle: sINTEGER);
  382. BEGIN
  383.  VDICall(4, 0, 0, 0, handle);
  384. END UpdateWorkstation;
  385.  
  386. PROCEDURE LoadFonts (handle, select: sINTEGER): sINTEGER;
  387. BEGIN
  388.  VDIIntIn[0]:= select;
  389.  VDICall(119, 0, 1, 0, handle);
  390.  RETURN VDIIntOut[0];
  391. END LoadFonts;
  392.  
  393. PROCEDURE UnloadFonts (handle, select: sINTEGER);
  394. BEGIN
  395.  VDIIntIn[0]:= select;
  396.  VDICall(120, 0, 1, 0, handle);
  397. END UnloadFonts;
  398.  
  399. PROCEDURE SetClipping (handle: sINTEGER; VAR rect: ARRAY OF LOC; do: BOOLEAN);
  400. BEGIN
  401.  array:= SYSTEM.ADR(rect);
  402.  VDIPtsIn[0]:= array^[0];
  403.  VDIPtsIn[1]:= array^[1];
  404.  VDIPtsIn[2]:= array^[2];
  405.  VDIPtsIn[3]:= array^[3];
  406.  IF do THEN  VDIIntIn[0]:= 1;  ELSE VDIIntIn[0]:= 0;  END;
  407.  VDICall(129, 2, 1, 0, handle);
  408. END SetClipping;
  409.  
  410. PROCEDURE InqCharcells (handle: sINTEGER; VAR rows, colums: sINTEGER);
  411. BEGIN
  412.  VDICall (5, 0, 0, 1, handle);
  413.  rows:= VDIIntOut[0];
  414.  colums:= VDIIntOut[1];
  415. END InqCharcells;
  416.  
  417. PROCEDURE ExitAlphamode (handle: sINTEGER);
  418. BEGIN
  419.  VDICall (5, 0, 0, 2, handle);
  420. END ExitAlphamode;
  421.  
  422. PROCEDURE EnterAlphamode (handle: sINTEGER);
  423. BEGIN
  424.  VDICall (5, 0, 0, 3, handle);
  425. END EnterAlphamode;
  426.  
  427. PROCEDURE AcursorUp (handle: sINTEGER);
  428. BEGIN
  429.  VDICall (5, 0, 0, 4, handle);
  430. END AcursorUp;
  431.  
  432. PROCEDURE AcursorDown (handle: sINTEGER);
  433. BEGIN
  434.  VDICall (5, 0, 0, 5, handle);
  435. END AcursorDown;
  436.  
  437. PROCEDURE AcursorRight (handle : sINTEGER);
  438. BEGIN
  439.  VDICall (5, 0, 0, 6, handle);
  440. END AcursorRight;
  441.  
  442. PROCEDURE AcursorLeft (handle: sINTEGER);
  443. BEGIN
  444.  VDICall (5, 0, 0, 7, handle);
  445. END AcursorLeft;
  446.  
  447. PROCEDURE HomeAcursor (handle: sINTEGER);
  448. BEGIN
  449.  VDICall (5, 0, 0, 8, handle);
  450. END HomeAcursor;
  451.  
  452. PROCEDURE EraseEOS (handle: sINTEGER);
  453. BEGIN
  454.  VDICall (5, 0, 0, 9, handle);
  455. END EraseEOS;
  456.  
  457. PROCEDURE EraseEOL (handle: sINTEGER);
  458. BEGIN
  459.  VDICall (5, 0, 0, 10, handle);
  460. END EraseEOL;
  461.  
  462. PROCEDURE AcursorAddress (handle, row, column: sINTEGER);
  463. BEGIN
  464.  VDIIntIn[0]:= row;
  465.  VDIIntIn[1]:= column;
  466.  VDICall (5, 0, 2, 11, handle);
  467. END AcursorAddress;
  468.  
  469. PROCEDURE CursorText (handle: sINTEGER; REF string: ARRAY OF CHAR);
  470. VAR h: sINTEGER;
  471.     i: sINTEGER;
  472.     a: SYSTEM.ADDRESS;
  473. BEGIN
  474.  (*
  475.  h:= HIGH(string); i:= 0;
  476.  SYSTEM.ASSEMBLER
  477.    MOVEQ        #0,D0
  478.    MOVE.W       h(A6),D1
  479.    MOVEQ        #0,D2
  480.    MOVE.L       string(A6),A0
  481.    LEA          VDIIntIn,A1
  482.  loop:
  483.    MOVE.B       (A0)+,D2
  484.    MOVE.W       D2,(A1)+
  485.    BEQ.S        exit
  486.    ADDQ.W       #1,D0
  487.    SUBQ.W       #1,D1
  488.    BNE.S        loop
  489.   exit:
  490.    MOVE.W       D0,i(A6)
  491.  END;
  492.  (*
  493.  LOOP
  494.   IF (i > h) OR (string[i] = 0C) THEN EXIT END;
  495.   VDIIntIn[i]:= ORD(string[i]);  INC(i);
  496.  END;
  497.  *)
  498.  *)
  499.  fillIntin (string, a, i);
  500.  VDIPB.intin := a;
  501.  IF (i = 0) THEN RETURN END;
  502.  VDICall (5, 0, i, 12, handle);
  503.  freeIntin (a);
  504. END CursorText;
  505.  
  506. PROCEDURE ReverseVideoOn (handle: sINTEGER);
  507. BEGIN
  508.  VDICall (5, 0, 0, 13, handle);
  509. END ReverseVideoOn;
  510.  
  511. PROCEDURE ReverseVideoOff (handle: sINTEGER);
  512. BEGIN
  513.  VDICall (5, 0, 0, 14, handle);
  514. END ReverseVideoOff;
  515.  
  516. PROCEDURE InqCursoraddress (handle: sINTEGER; VAR row, column: sINTEGER);
  517. BEGIN
  518.  VDICall (5, 0, 0, 15, handle);
  519.  row:= VDIIntOut[0];
  520.  column:= VDIIntOut[1];
  521. END InqCursoraddress;
  522.  
  523. PROCEDURE InqTabletstatus (handle: sINTEGER): sINTEGER;
  524. BEGIN
  525.  VDICall (5, 0, 0, 16, handle);
  526.  RETURN VDIIntOut[0];
  527. END InqTabletstatus;
  528.  
  529. PROCEDURE Hardcopy (handle: sINTEGER);
  530. BEGIN
  531.  VDICall (5, 0, 0, 17, handle);
  532. END Hardcopy;
  533.  
  534. PROCEDURE DisplayCursor (handle, x, y: sINTEGER);
  535. BEGIN
  536.  VDICall (5, 1, 0, 18, handle);
  537.  VDIPtsIn[0]:= x;
  538.  VDIPtsIn[1]:= y;
  539. END DisplayCursor;
  540.  
  541. PROCEDURE RemoveCursor (handle: sINTEGER);
  542. BEGIN
  543.  VDICall (5, 0, 0, 19, handle);
  544. END RemoveCursor;
  545.  
  546. PROCEDURE FormAdvance (handle: sINTEGER);
  547. BEGIN
  548.  VDICall (5, 0, 0, 20, handle);
  549. END FormAdvance;
  550.  
  551. PROCEDURE OutputWindow (handle: sINTEGER; VAR pxy: ARRAY OF LOC);
  552. VAR i: sINTEGER;
  553. BEGIN
  554.  array:= SYSTEM.ADR(pxy);
  555.  FOR i:= 0 TO 3 DO VDIPtsIn[i]:= array^[i]; END;
  556.  VDICall (5, 2, 0, 21, handle);
  557. END OutputWindow;
  558.  
  559. PROCEDURE ClearDisplaylist (handle: sINTEGER);
  560. BEGIN
  561.  VDICall (5, 0, 0, 22, handle);
  562. END ClearDisplaylist;
  563.  
  564. PROCEDURE Bitimagefile (handle: sINTEGER; REF fileName: ARRAY OF CHAR;
  565.                         aspect, scaling, numPts: sINTEGER;
  566.                         VAR pxy: ARRAY OF LOC);
  567. VAR (*$Reg*)  h: sINTEGER;
  568.     (*$Reg*)  i: sINTEGER;
  569. BEGIN
  570.  VDIIntIn[0]:= aspect;
  571.  VDIIntIn[1]:= scaling;
  572.  h:= HIGH (fileName);
  573.  i:= 0;
  574.  LOOP
  575.   IF (i > h) OR (fileName [i] = 0C) THEN EXIT END;
  576.   VDIIntIn[2+i]:= ORD (fileName[i]);
  577.   INC (i);
  578.  END; (* LOOP *)
  579.  IF (i = 0) THEN RETURN END;
  580.  VDIIntIn[i+2]:= 0;   (* terminate array properly *)
  581.  array:= SYSTEM.ADR (pxy);
  582.  VDIPtsIn[0]:= array^[0];
  583.  VDIPtsIn[1]:= array^[1];
  584.  VDIPtsIn[2]:= array^[2];
  585.  VDIPtsIn[3]:= array^[3];
  586.  VDICall (5, numPts, 3+i, 23, handle);
  587. END Bitimagefile;
  588.  
  589. PROCEDURE InqPrinterscan(handle: sINTEGER; VAR gSlice, gPage, size, page, div: sINTEGER);
  590. BEGIN
  591.  VDICall (5, 0, 0, 24, handle);
  592.  gSlice:= VDIIntOut[0];
  593.  gPage:= VDIIntOut[1];
  594.  size:= VDIIntOut[2];
  595.  page:= VDIIntOut[3];
  596.  div:= VDIIntOut[4];
  597. END InqPrinterscan;
  598.  
  599. PROCEDURE PrintText (handle: sINTEGER; REF string: ARRAY OF CHAR);
  600. VAR h, i: sINTEGER;
  601.     a   : SYSTEM.ADDRESS;
  602. BEGIN
  603.  (*
  604.  h:= HIGH(string); i:= 0;
  605.  SYSTEM.ASSEMBLER
  606.    MOVEQ        #0,D0
  607.    MOVE.W       h(A6),D1
  608.    MOVEQ        #0,D2
  609.    MOVE.L       string(A6),A0
  610.    LEA          VDIIntIn,A1
  611.  loop:
  612.    MOVE.B       (A0)+,D2
  613.    MOVE.W       D2,(A1)+
  614.    BEQ.S        exit
  615.    ADDQ.W       #1,D0
  616.    SUBQ.W       #1,D1
  617.    BNE.S        loop
  618.   exit:
  619.    MOVE.W       D0,i(A6)
  620.  END;
  621.  (*
  622.  LOOP
  623.   IF (i > h) OR (string[i] = 0C) THEN EXIT END;
  624.   VDIIntIn[i]:= ORD(string[i]);  INC(i);
  625.  END;
  626.  *)
  627.  *)
  628.  fillIntin (string, a, i);
  629.  VDIPB.intin := a;
  630.  IF (i = 0) THEN RETURN END;
  631.  VDICall (5, 0, i, 25, handle);
  632.  freeIntin (a);
  633. END PrintText;
  634.  
  635. PROCEDURE SelectPalette (handle, palette: sINTEGER): sINTEGER;
  636. BEGIN
  637.  VDIIntIn[0]:= palette;
  638.  VDICall (5, 0, 1, 60, handle);
  639.  RETURN VDIIntOut[0];
  640. END SelectPalette;
  641.  
  642. PROCEDURE GenerateTone(handle, freq, time: sINTEGER);
  643. BEGIN
  644.  VDIIntIn[0]:= freq;
  645.  VDIIntIn[1]:= time;
  646.  VDICall (5, 0, 2, 61, handle);
  647. END GenerateTone;
  648.  
  649. PROCEDURE ToneMultiflag (handle, action: sINTEGER);
  650. BEGIN
  651.  VDIIntIn[0]:= action;
  652.  VDICall (5, 0, 1, 62, handle);
  653. END ToneMultiflag;
  654.  
  655. PROCEDURE SetTabletaxisInch (handle, xres, yres: sINTEGER;
  656.                              VAR xset, yset: sINTEGER);
  657. BEGIN
  658.  VDIIntIn[0]:= xres;
  659.  VDIIntIn[1]:= yres;
  660.  VDICall (5, 0, 2, 81, handle);
  661.  xset:= VDIIntIn[0];
  662.  yset:= VDIIntIn[1];
  663. END SetTabletaxisInch;
  664.  
  665. PROCEDURE SetTabletaxisLine (handle, xres, yres: sINTEGER;
  666.                              VAR xset, yset: sINTEGER);
  667. BEGIN
  668.  VDIIntIn[0]:= xres;
  669.  VDIIntIn[1]:= yres;
  670.  VDICall (5, 0, 2, 82, handle);
  671.  xset:= VDIIntIn[0];
  672.  yset:= VDIIntIn[1];
  673. END SetTabletaxisLine;
  674.  
  675. PROCEDURE SetTabletorigin (handle, x, y: sINTEGER);
  676. BEGIN
  677.  VDIIntIn[0]:= x;
  678.  VDIIntIn[1]:= y;
  679.  VDICall (5, 0, 2, 83, handle);
  680. END SetTabletorigin;
  681.  
  682. PROCEDURE InqTabletorigin (handle: sINTEGER; VAR x, y: sINTEGER);
  683. BEGIN
  684.  VDICall (5, 0, 0, 84, handle);
  685.  x:= VDIIntIn[0];
  686.  y:= VDIIntIn[1];
  687. END InqTabletorigin;
  688.  
  689. PROCEDURE SetTabletalignment (handle, x, y: sINTEGER);
  690. BEGIN
  691.  VDIIntIn[0]:= x;
  692.  VDIIntIn[1]:= y;
  693.  VDICall (5, 0, 2, 85, handle);
  694. END SetTabletalignment;
  695.  
  696. PROCEDURE SetFilmtype (handle, index, light: sINTEGER);
  697. BEGIN
  698.  VDIIntIn[0]:= index;
  699.  VDIIntIn[1]:= light;
  700.  VDICall (5, 0, 2, 91, handle);
  701. END SetFilmtype;
  702.  
  703. PROCEDURE InqFilmname (handle: sINTEGER; VAR filmName: ARRAY OF CHAR);
  704. VAR i: sINTEGER;
  705. BEGIN
  706.  VDICall (5, 0, 1, 92, handle);
  707.  FOR i:= 0 TO 24 DO filmName[i]:= CHR(VDIIntOut[i]) END;
  708. END InqFilmname;
  709.  
  710. PROCEDURE SetFilmexposure (handle, state: sINTEGER);
  711. BEGIN
  712.  VDIIntIn[0]:= state;
  713.  VDICall (5, 0, 1, 93, handle);
  714. END SetFilmexposure;
  715.  
  716. PROCEDURE UpdateMetafile (handle, minX, minY, maxX, maxY: sINTEGER);
  717. BEGIN
  718.  VDIPtsIn[0]:= minX;
  719.  VDIPtsIn[1]:= minY;
  720.  VDIPtsIn[2]:= maxX;
  721.  VDIPtsIn[3]:= maxY;
  722.  VDICall (5, 2, 0, 98, handle);
  723. END UpdateMetafile;
  724.  
  725. PROCEDURE WriteMetafile (handle, numIntin: sINTEGER;  VAR intIn: ARRAY OF LOC;
  726.                          numPtsin: sINTEGER;  VAR ptsIn: ARRAY OF LOC);
  727. VAR oldInt, oldPts: SYSTEM.ADDRESS;
  728. BEGIN
  729.  oldInt:= VDIPB.intin;
  730.  oldPts:= VDIPB.ptsin;
  731.  VDIPB.intin:= SYSTEM.ADR (intIn);
  732.  VDIPB.ptsin:= SYSTEM.ADR (ptsIn);
  733.  VDICall (5, numPtsin, numIntin, 99, handle);
  734.  VDIPB.intin:= oldInt;
  735.  VDIPB.ptsin:= oldPts;
  736. END WriteMetafile;
  737.  
  738. PROCEDURE PhysicalPagesize (handle, width, height: sINTEGER);
  739. BEGIN
  740.  VDIIntIn[0]:= 0;
  741.  VDIIntIn[1]:= width;
  742.  VDIIntIn[2]:= height;
  743.  VDICall (5, 0, 3, 99, handle);
  744. END PhysicalPagesize;
  745.  
  746. PROCEDURE CoordinateWindow (handle, llx, lly, urx, ury: sINTEGER);
  747. BEGIN
  748.  VDIIntIn[0]:= 1;
  749.  VDIIntIn[1]:= llx;
  750.  VDIIntIn[2]:= lly;
  751.  VDIIntIn[3]:= urx;
  752.  VDIIntIn[4]:= ury;
  753.  VDICall (5, 0, 5, 99, handle);
  754. END CoordinateWindow;
  755.  
  756. PROCEDURE ChangeVdiFilename (handle: sINTEGER; REF fileName: ARRAY OF CHAR);
  757. VAR (*$Reg*)  h: sINTEGER;
  758.     (*$Reg*)  i: sINTEGER;
  759. BEGIN
  760.  h:= HIGH(fileName);  i:= 0;
  761.  LOOP
  762.   IF (i > h) OR (fileName [i] = 0C) THEN EXIT END;
  763.   VDIIntIn[i]:= ORD (fileName[i]);  INC (i);
  764.  END; (* LOOP *);
  765.  IF (i = 0) THEN RETURN END;
  766.  VDIIntIn[i]:= 0;
  767.  VDICall (5, 0, i, 100, handle);
  768. END ChangeVdiFilename;
  769.  
  770. PROCEDURE SetLineoffset (handle, offset: sINTEGER);
  771. BEGIN
  772.  VDIIntIn[0]:= offset;
  773.  VDICall (5, 0, 1, 101, handle);
  774. END SetLineoffset;
  775.  
  776. PROCEDURE InitSystemfont (handle: sINTEGER; VAR header: ARRAY OF LOC);
  777. BEGIN
  778.  array:= SYSTEM.ADR (header);
  779.  VDIIntIn[0]:= array^[0];
  780.  VDIIntIn[1]:= array^[1];
  781.  VDICall (5, 0, 2, 102, handle);
  782. END InitSystemfont;
  783.  
  784. VAR old:   SYSTEM.ADDRESS;
  785.     trick: POINTER TO SYSTEM.ADDRESS;
  786.  
  787. PROCEDURE SetInputmode (handle, device, mode: sINTEGER): sINTEGER;
  788. BEGIN
  789.  VDIIntIn[0]:= device;
  790.  VDIIntIn[1]:= mode;
  791.  VDICall(33, 0, 2, 0, handle);
  792.  RETURN VDIIntOut[0];
  793. END SetInputmode;
  794.  
  795. PROCEDURE InputLocatorRQ (handle, x, y: sINTEGER; VAR xo, yo: sINTEGER; VAR term: CHAR);
  796. BEGIN
  797.  VDIPtsIn[0]:= x;
  798.  VDIPtsIn[1]:= y;
  799.  VDICall(28, 1, 0, 0, handle);
  800.  xo:= VDIPtsOut[0];
  801.  yo:= VDIPtsOut[1];
  802.  term:= CHR(VDIIntOut[0]);
  803. END InputLocatorRQ;
  804.  
  805. PROCEDURE InputLocatorSM (handle, x, y: sINTEGER; VAR xo, yo: sINTEGER;
  806.                      VAR term: CHAR): sBITSET;
  807. VAR bs: sBITSET;
  808.     l:  lCARDINAL;
  809. BEGIN
  810.  VDIPtsIn[0]:= x;
  811.  VDIPtsIn[1]:= y;
  812.  VDIControl[0]:= 28;
  813.  VDIControl[1]:= 1;
  814.  VDIControl[3]:= 0;
  815.  VDIControl[5]:= 0;
  816.  VDIControl[6]:= handle;
  817.  MagicSys.CallGEM (115, vdipb);
  818.    SYSTEM.ASSEMBLER  MOVE.L  D0, l(A6)  END;  
  819.  
  820.  
  821.  
  822.  xo:= VDIPtsOut[0];
  823.  yo:= VDIPtsOut[1];
  824.  term:= CHR(VDIIntOut[0]);
  825.  bs:= CastToBitset (l);
  826.  RETURN bs;
  827. END InputLocatorSM;
  828.  
  829. PROCEDURE InputValuatorRQ (handle, in: sINTEGER; VAR out: sINTEGER; VAR term: CHAR);
  830. BEGIN
  831.  VDIIntIn[0] := in;
  832.  VDICall (29, 0, 1, 0, handle);
  833.  out:= VDIIntOut[0];
  834.  term:= CHR(VDIIntOut[1]);
  835. END InputValuatorRQ;
  836.  
  837. PROCEDURE InputValuatorSM (handle, in: sINTEGER; VAR out: sINTEGER;
  838.                       VAR term: CHAR): sBITSET;
  839. BEGIN
  840.  VDIIntIn[0] := in;
  841.  VDICall (29, 0, 1, 0, handle);
  842.  out:= VDIIntOut[0];
  843.  term:= CHR(VDIIntOut[1]);
  844.  RETURN CastToBitset (VDIControl[4]);
  845. END InputValuatorSM;
  846.  
  847. PROCEDURE InputChoiceRQ (handle, in: sINTEGER; VAR out: sINTEGER);
  848. BEGIN
  849.  VDIIntIn[0] := in;
  850.  VDICall (30, 0, 1, 0, handle);
  851.  out:= VDIIntOut[0];
  852. END InputChoiceRQ;
  853.  
  854. PROCEDURE InputChoiceSM (handle: sINTEGER; VAR choice: sINTEGER ): sINTEGER;
  855. BEGIN
  856.  VDICall (30, 0, 0, 0, handle);
  857.  choice:= VDIIntOut [0];
  858.  RETURN VDIControl[4];
  859. END InputChoiceSM;
  860.  
  861. PROCEDURE InputStringRQ (handle, len: sINTEGER; echo: BOOLEAN;
  862.                     VAR xy: ARRAY OF LOC;
  863.                     VAR string: ARRAY OF CHAR);
  864. VAR (*$Reg*)  h: sINTEGER;
  865.     (*$Reg*)  i: sINTEGER;
  866. BEGIN
  867.  VDIIntIn[0]:= len;
  868.  IF echo THEN  VDIIntIn[1]:= 1;  ELSE  VDIIntIn[1]:= 0;  END;
  869.  array:= SYSTEM.ADR(xy);
  870.  VDIPtsIn[0]:= array^[0];
  871.  VDIPtsIn[1]:= array^[1];
  872.  VDICall (31, 1, 2, 0, handle);
  873.  h:= VDIControl[4] - 1;
  874.  FOR i:= 0 TO h DO string[i]:= CHR(VDIIntOut[i]) END;
  875.  string [h + 1]:= 0C;
  876. END InputStringRQ;
  877.  
  878. PROCEDURE InputStringSM (handle, len: sINTEGER; echo: BOOLEAN;
  879.                     VAR xy: ARRAY OF LOC;
  880.                     VAR string: ARRAY OF CHAR): sINTEGER;
  881. VAR (*$Reg*)  h: sINTEGER;
  882.     (*$Reg*)  i: sINTEGER;
  883. BEGIN
  884.  VDIIntIn[0]:= len;
  885.  IF echo THEN  VDIIntIn[1]:= 1;  ELSE  VDIIntIn[1]:= 0;  END;
  886.  array:= SYSTEM.ADR(xy);
  887.  VDIPtsIn[0]:= array^[0];
  888.  VDIPtsIn[1]:= array^[1];
  889.  VDICall (31, 1, 2, 0, handle);
  890.  h:= VDIControl[4] - 1;
  891.  FOR i:= 0 TO h DO string[i]:= CHR(VDIIntOut[i]) END;
  892.  string [h + 1]:= 0C;
  893.  RETURN VDIControl[4];
  894. END InputStringSM;
  895.  
  896. PROCEDURE SetMouseform (handle: sINTEGER; VAR form: ARRAY OF LOC);
  897. BEGIN
  898.  old:= VDIPB.intin;
  899.  VDIPB.intin:= SYSTEM.ADR (form);
  900.  VDICall (111, 0, 37, 0, handle);
  901.  VDIPB.intin:= old;
  902. END SetMouseform;
  903.  
  904. PROCEDURE ShowCursor (handle: sINTEGER; reset: BOOLEAN);
  905. BEGIN
  906.  IF reset THEN  VDIIntIn[0]:= 0;  ELSE  VDIIntIn[0]:= 1;  END;
  907.  VDICall (122, 0, 1, 0, handle);
  908. END ShowCursor;
  909.  
  910. PROCEDURE HideCursor (handle: sINTEGER);
  911. BEGIN
  912.  VDICall (123, 0, 0, 0, handle);
  913. END HideCursor;
  914.  
  915. PROCEDURE SampleMouse (handle: sINTEGER; VAR stat: sBITSET; VAR x, y: sINTEGER);
  916. BEGIN
  917.  VDICall (124, 0, 0, 0, handle);
  918.  stat:= CastToBitset (VDIIntOut[0]);
  919.  x:= VDIPtsOut[0];
  920.  y:= VDIPtsOut[1];
  921. END SampleMouse;
  922.  
  923. PROCEDURE ExTimerVector (handle: sINTEGER; new: SYSTEM.ADDRESS;
  924.                          VAR intervall: sINTEGER): SYSTEM.ADDRESS;
  925. BEGIN
  926.  trick:= SYSTEM.ADR (VDIControl[7]);  trick^:= new;
  927.  VDICall (118, 0, 0, 0, handle);
  928.  intervall:= VDIIntOut[0];
  929.  trick:= SYSTEM.ADR (VDIControl[9]);
  930.  RETURN trick^;
  931. END ExTimerVector;
  932.  
  933. PROCEDURE ExButtonVector (handle: sINTEGER; new: SYSTEM.ADDRESS): SYSTEM.ADDRESS;
  934. BEGIN
  935.  trick:= SYSTEM.ADR (VDIControl[7]); trick^:= new;
  936.  VDICall (125, 0, 0, 0, handle);
  937.  trick:= SYSTEM.ADR (VDIControl[9]);
  938.  RETURN trick^;
  939. END ExButtonVector;
  940.  
  941. PROCEDURE ExMovementVector (handle: sINTEGER; new: SYSTEM.ADDRESS): SYSTEM.ADDRESS;
  942. BEGIN
  943.  trick:= SYSTEM.ADR (VDIControl[7]); trick^:= new;
  944.  VDICall (126, 0, 0, 0, handle);
  945.  trick:= SYSTEM.ADR (VDIControl[9]);
  946.  RETURN trick^;
  947. END ExMovementVector;
  948.  
  949. PROCEDURE ExCursorVector (handle: sINTEGER; new: SYSTEM.ADDRESS): SYSTEM.ADDRESS;
  950. BEGIN
  951.  trick:= SYSTEM.ADR (VDIControl[7]); trick^:= new;
  952.  VDICall (127, 0, 0, 0, handle);
  953.  trick:= SYSTEM.ADR (VDIControl[9]);
  954.  RETURN trick^;
  955. END ExCursorVector;
  956.  
  957. PROCEDURE SampleKeyboard (handle: sINTEGER; VAR status: sBITSET);
  958. BEGIN
  959.  VDICall (128, 0, 0, 0, handle);
  960.  status:= CastToBitset (VDIIntOut[0]);
  961. END SampleKeyboard;
  962.  
  963. PROCEDURE ExtendedInq (handle, wich: sINTEGER; VAR out: ARRAY OF LOC);
  964. VAR i: sINTEGER;
  965. BEGIN
  966.  VDIIntIn[0]:= wich;
  967.  VDICall (102, 0, 1, 0, handle);
  968.  array:= SYSTEM.ADR (out);
  969.  FOR i:=  0 TO 44 DO array^[i]:= VDIIntOut[i]; END;
  970.  FOR i:= 45 TO 56 DO array^[i]:= VDIPtsOut[i-45]; END;
  971. END ExtendedInq;
  972.  
  973. PROCEDURE InqColor (handle, color: sINTEGER; set: BOOLEAN; VAR rgb: ARRAY OF LOC);
  974. BEGIN
  975.  VDIIntIn[0]:= color;
  976.  IF set THEN  VDIIntIn[1]:= 0;  ELSE  VDIIntIn[1]:= 1;  END;
  977.  VDICall (26, 0, 2, 0, handle);
  978.  array:= SYSTEM.ADR(rgb);
  979.  array^[0]:= VDIIntOut[1];
  980.  array^[1]:= VDIIntOut[2];
  981.  array^[2]:= VDIIntOut[3];
  982. END InqColor;
  983.  
  984. PROCEDURE InqLine (handle: sINTEGER; VAR attrib: ARRAY OF LOC);
  985. BEGIN
  986.  VDICall (35, 0, 0, 0, handle);
  987.  array:= SYSTEM.ADR(attrib);
  988.  array^[0]:= VDIIntOut[0];
  989.  array^[1]:= VDIIntOut[1];
  990.  array^[2]:= VDIIntOut[2];
  991.  array^[3]:= VDIPtsOut[0];
  992. END InqLine;
  993.  
  994. PROCEDURE InqMarker (handle: sINTEGER; VAR attrib: ARRAY OF LOC);
  995. BEGIN
  996.  VDICall (36, 0, 0, 0, handle);
  997.  array:= SYSTEM.ADR(attrib);
  998.  array^[0]:= VDIIntOut[0];
  999.  array^[1]:= VDIIntOut[1];
  1000.  array^[2]:= VDIIntOut[2];
  1001.  array^[3]:= VDIPtsOut[1];
  1002. END InqMarker;
  1003.  
  1004. PROCEDURE InqFill (handle: sINTEGER; VAR attrib: ARRAY OF LOC);
  1005. VAR i: sINTEGER;
  1006. BEGIN
  1007.  VDICall (37, 0, 0, 0, handle);
  1008.  array:= SYSTEM.ADR(attrib);
  1009.  FOR i:= 0 TO 4 DO array^[i]:= VDIIntOut[i]; END;
  1010. END InqFill;
  1011.  
  1012. PROCEDURE InqText (handle: sINTEGER; VAR attrib: ARRAY OF LOC);
  1013. VAR i: sINTEGER;
  1014. BEGIN
  1015.  VDICall (38, 0, 0, 0, handle);
  1016.  array:= SYSTEM.ADR(attrib);
  1017.  FOR i:= 0 TO 5 DO array^[i]:= VDIIntOut[i]; END;
  1018.  FOR i:= 6 TO 9 DO array^[i]:= VDIPtsOut[i-6]; END;
  1019. END InqText;
  1020.  
  1021. PROCEDURE InqTextextent (handle: sINTEGER; REF string: ARRAY OF CHAR;
  1022.                       VAR extent: ARRAY OF LOC);
  1023. VAR h: sINTEGER;
  1024.     i: sINTEGER;
  1025.     a: SYSTEM.ADDRESS;
  1026. BEGIN
  1027.  (*
  1028.  i:= 0;
  1029.  h:= HIGH(string);
  1030.  SYSTEM.ASSEMBLER
  1031.    MOVEQ        #0,D0
  1032.    MOVE.W       h(A6),D1
  1033.    MOVEQ        #0,D2
  1034.    MOVE.L       string(A6),A0
  1035.    LEA          VDIIntIn,A1
  1036.  loop:
  1037.    MOVE.B       (A0)+,D2
  1038.    MOVE.W       D2,(A1)+
  1039.    BEQ.S        exit
  1040.    ADDQ.W       #1,D0
  1041.    SUBQ.W       #1,D1
  1042.    BNE.S        loop
  1043.   exit:
  1044.    MOVE.W       D0,i(A6)
  1045.  END;
  1046.  (*
  1047.  LOOP
  1048.   IF (i > h) OR (string[i] = 0C) THEN EXIT END;
  1049.   VDIIntIn[i]:= ORD(string[i]);  INC (i);
  1050.  END;
  1051.  *)
  1052.  *)
  1053.  fillIntin (string, a, i);
  1054.  VDIPB.intin := a;
  1055.  VDICall (116, 0, i, 0, handle);
  1056.  array:= SYSTEM.ADR(extent);
  1057.  FOR i:= 0 TO 7 DO  array^[i]:= VDIPtsOut[i]; END;
  1058.  freeIntin (a);
  1059. END InqTextextent;
  1060.  
  1061. PROCEDURE InqCharwidth (handle: sINTEGER; ch: CHAR; 
  1062.                         VAR width, left, right: sINTEGER): sINTEGER;
  1063. BEGIN
  1064.  VDIIntIn[0]:= ORD(ch);
  1065.  VDICall (117, 0, 1, 0, handle);
  1066.  width:= VDIPtsOut[0];
  1067.  left:= VDIPtsOut[2];
  1068.  right:= VDIPtsOut[4];
  1069.  RETURN VDIIntOut[0];
  1070. END InqCharwidth;
  1071.  
  1072. PROCEDURE InqFacename (handle, element: sINTEGER; VAR name: ARRAY OF CHAR): sINTEGER;
  1073. VAR i: sINTEGER;
  1074. BEGIN
  1075.  VDIIntIn[0]:= element;
  1076.  VDICall (130, 0, 1, 0, handle);
  1077.  FOR i:= 1 TO 32 DO name[i-1]:= CHR(VDIIntOut[i]) END;
  1078.  RETURN VDIIntOut[0];
  1079. END InqFacename;
  1080.  
  1081. PROCEDURE InqCellarray (handle: sINTEGER; VAR pxy: ARRAY OF LOC;
  1082.                      len, rows: sINTEGER; VAR elUsed, rowsUsed, status: sINTEGER;
  1083.                      VAR colArray: ARRAY OF LOC);
  1084. VAR i: sINTEGER;
  1085. BEGIN
  1086.  array:= SYSTEM.ADR(pxy);
  1087.  FOR i:= 0 TO 3 DO VDIPtsIn[i]:= array^[i]; END;
  1088.  VDIControl[7]:= len;
  1089.  VDIControl[8]:= rows;
  1090.  old:= VDIPB.ptsin;
  1091.  VDIPB.ptsin:= SYSTEM.ADR (colArray);
  1092.  VDICall (27, 2, 0, 0, handle);
  1093.  VDIPB.ptsin:= old;
  1094.  elUsed:= VDIControl[9];
  1095.  rowsUsed:= VDIControl[10];
  1096.  status:= VDIControl[11];
  1097. END InqCellarray;
  1098.  
  1099. PROCEDURE InqInputmode (handle: sINTEGER; dev: sINTEGER): sINTEGER;
  1100. BEGIN
  1101.  VDIIntIn[0]:= ORD(dev);
  1102.  VDICall (115, 0, 1, 0, handle);
  1103.  RETURN VDIIntOut[0];
  1104. END InqInputmode;
  1105.  
  1106. PROCEDURE InqFaceinfo (handle : sINTEGER; VAR minADE, maxADE, maxWidth: sINTEGER;
  1107.                     VAR dist: ARRAY OF LOC;  VAR effects: ARRAY OF LOC);
  1108. VAR i: sINTEGER;
  1109. BEGIN
  1110.  VDICall (131, 0, 0, 0, handle);
  1111.  minADE:= VDIIntOut[0];
  1112.  maxADE:= VDIIntOut[1];
  1113.  array:= SYSTEM.ADR(dist);
  1114.  FOR i:= 0 TO 4 DO array^[i]:= VDIPtsOut[2 * i + 1]; END;
  1115.  maxWidth:= VDIPtsOut[0];
  1116.  array:= SYSTEM.ADR(effects);
  1117.  array^[0]:= VDIPtsOut[2];
  1118.  array^[1]:= VDIPtsOut[4];
  1119.  array^[2]:= VDIPtsOut[6];
  1120. END InqFaceinfo;
  1121.  
  1122. VAR oldPts: SYSTEM.ADDRESS;
  1123.     oldInt: SYSTEM.ADDRESS;
  1124.  
  1125. PROCEDURE Polyline (handle, count: sINTEGER; pxy: ARRAY OF LOC);
  1126. BEGIN
  1127.  oldPts:= VDIPB.ptsin;
  1128.  VDIPB.ptsin:= SYSTEM.ADR (pxy);
  1129.  VDICall(6, count, 0, 0, handle);
  1130.  VDIPB.ptsin:= oldPts;
  1131. END Polyline;
  1132.  
  1133. PROCEDURE Polymarker (handle, count: sINTEGER; pxy: ARRAY OF LOC);
  1134. BEGIN
  1135.  oldPts:= VDIPB.ptsin;
  1136.  VDIPB.ptsin:= SYSTEM.ADR (pxy);
  1137.  VDICall(7, count, 0, 0, handle);
  1138.  VDIPB.ptsin:= oldPts;
  1139. END Polymarker;
  1140.  
  1141. PROCEDURE Text (handle, x, y: sINTEGER; REF string: ARRAY OF CHAR);
  1142. VAR   c: sINTEGER;
  1143.       h: sCARDINAL;
  1144.       a: SYSTEM.ADDRESS;
  1145. BEGIN
  1146.  fillIntin (string, a, c);
  1147.  (*
  1148.  WHILE (c <= h) AND (string[c] # 0C) DO
  1149.   VDIIntIn[c]:= ORD(string[c]);  INC(c);
  1150.  END;
  1151.  *)
  1152.  
  1153.  VDIPB.intin:= a;
  1154.  VDIPtsIn[0]:= x;
  1155.  VDIPtsIn[1]:= y;
  1156.  VDICall(8, 1, c, 0, handle);
  1157.  freeIntin (a);
  1158. END Text;
  1159.  
  1160. PROCEDURE FilledArea (handle, count: sINTEGER; pxy: ARRAY OF LOC);
  1161. BEGIN
  1162.  oldPts:= VDIPB.ptsin;
  1163.  VDIPB.ptsin:= SYSTEM.ADR (pxy);
  1164.  VDICall(9, count, 0, 0, handle);
  1165.  VDIPB.ptsin:= oldPts;
  1166. END FilledArea;
  1167.  
  1168. PROCEDURE CellArray (handle, len, used, rows, mode: sINTEGER;
  1169.                      VAR pxy, color: ARRAY OF LOC);
  1170. BEGIN
  1171.  VDIControl[7]:= len;
  1172.  VDIControl[8]:= used;
  1173.  VDIControl[9]:= rows;
  1174.  VDIControl[10]:= mode;
  1175.  oldPts:= VDIPB.intin;
  1176.  oldInt:= VDIPB.ptsin;
  1177.  VDIPB.ptsin:= SYSTEM.ADR (pxy);
  1178.  VDIPB.intin:= SYSTEM.ADR (color);
  1179.  VDICall(10, 2, len * rows, 0, handle);
  1180.  VDIPB.ptsin:= oldPts;
  1181.  VDIPB.intin:= oldInt;
  1182. END CellArray;
  1183.  
  1184. PROCEDURE ContourFill (handle, x, y, index: sINTEGER);
  1185. BEGIN
  1186.  VDIIntIn[0]:= index;
  1187.  VDIPtsIn[0]:= x;
  1188.  VDIPtsIn[1]:= y;
  1189.  VDICall(103, 1, 1, 0, handle);
  1190. END ContourFill;
  1191.  
  1192. PROCEDURE FillRectangle (handle: sINTEGER; pxy: ARRAY OF LOC);
  1193. BEGIN
  1194.  oldPts:= VDIPB.ptsin;
  1195.  VDIPB.ptsin:= SYSTEM.ADR (pxy);
  1196.  VDICall(114, 2, 0, 0, handle);
  1197.  VDIPB.ptsin:= oldPts;
  1198. END FillRectangle;
  1199.  
  1200. PROCEDURE Bar (handle: sINTEGER; pxy: ARRAY OF LOC);
  1201. BEGIN
  1202.  oldPts:= VDIPB.ptsin;
  1203.  VDIPB.ptsin:= SYSTEM.ADR (pxy);
  1204.  VDICall(11, 2, 0, 1, handle);
  1205.  VDIPB.ptsin:= oldPts;
  1206. END Bar;
  1207.  
  1208. PROCEDURE Arc (handle, x, y, rad, beg, end: sINTEGER);
  1209. BEGIN
  1210.  VDIPtsIn[0]:= x;
  1211.  VDIPtsIn[1]:= y;
  1212.  VDIPtsIn[2]:= 0;
  1213.  VDIPtsIn[3]:= 0;
  1214.  VDIPtsIn[4]:= 0;
  1215.  VDIPtsIn[5]:= 0;
  1216.  VDIPtsIn[6]:= rad;
  1217.  VDIPtsIn[7]:= 0;
  1218.  VDIIntIn[0]:= beg;
  1219.  VDIIntIn[1]:= end;
  1220.  VDICall(11, 4, 2, 2, handle);
  1221. END Arc;
  1222.  
  1223. PROCEDURE Pie (handle, x, y, rad, beg, end: sINTEGER);
  1224. BEGIN
  1225.  VDIPtsIn[0]:= x;
  1226.  VDIPtsIn[1]:= y;
  1227.  VDIPtsIn[2]:= 0;
  1228.  VDIPtsIn[3]:= 0;
  1229.  VDIPtsIn[4]:= 0;
  1230.  VDIPtsIn[5]:= 0;
  1231.  VDIPtsIn[6]:= rad;
  1232.  VDIPtsIn[7]:= 0;
  1233.  VDIIntIn[0]:= beg;
  1234.  VDIIntIn[1]:= end;
  1235.  VDICall(11, 4, 2, 3, handle);
  1236. END Pie;
  1237.  
  1238. PROCEDURE Circle (handle, x, y, rad: sINTEGER);
  1239. BEGIN
  1240.  VDIPtsIn[0]:= x;
  1241.  VDIPtsIn[1]:= y;
  1242.  VDIPtsIn[2]:= 0;
  1243.  VDIPtsIn[3]:= 0;
  1244.  VDIPtsIn[4]:= rad;
  1245.  VDIPtsIn[5]:= 0;
  1246.  VDICall(11, 3, 0, 4, handle);
  1247. END Circle;
  1248.  
  1249. PROCEDURE Ellipse (handle, x, y, xrad, yrad: sINTEGER);
  1250. BEGIN
  1251.  VDIPtsIn[0]:= x;
  1252.  VDIPtsIn[1]:= y;
  1253.  VDIPtsIn[2]:= xrad;
  1254.  VDIPtsIn[3]:= yrad;
  1255.  VDICall(11, 2, 0, 5, handle);
  1256. END Ellipse;
  1257.  
  1258. PROCEDURE EllipticalArc (handle, x, y, xrad, yrad, beg, end: sINTEGER);
  1259. BEGIN
  1260.  VDIPtsIn[0]:= x;
  1261.  VDIPtsIn[1]:= y;
  1262.  VDIPtsIn[2]:= xrad;
  1263.  VDIPtsIn[3]:= yrad;
  1264.  VDIIntIn[0]:= beg;
  1265.  VDIIntIn[1]:= end;
  1266.  VDICall(11, 2, 2, 6, handle);
  1267. END EllipticalArc;
  1268.  
  1269. PROCEDURE EllipticalPie (handle, x, y, xrad, yrad, beg, end: sINTEGER);
  1270. BEGIN
  1271.  VDIPtsIn[0]:= x;
  1272.  VDIPtsIn[1]:= y;
  1273.  VDIPtsIn[2]:= xrad;
  1274.  VDIPtsIn[3]:= yrad;
  1275.  VDIIntIn[0]:= beg;
  1276.  VDIIntIn[1]:= end;
  1277.  VDICall(11, 2, 2, 7, handle);
  1278. END EllipticalPie;
  1279.  
  1280. PROCEDURE RoundedRectangle (handle: sINTEGER; pxy: ARRAY OF LOC);
  1281. BEGIN
  1282.  oldPts:= VDIPB.ptsin;
  1283.  VDIPB.ptsin:= SYSTEM.ADR (pxy);
  1284.  VDICall(11, 2, 0, 8, handle);
  1285.  VDIPB.ptsin:= oldPts;
  1286. END RoundedRectangle;
  1287.  
  1288. PROCEDURE FilledRoundedRectangle (handle: sINTEGER; pxy: ARRAY OF LOC);
  1289. BEGIN
  1290.  oldPts:= VDIPB.ptsin;
  1291.  VDIPB.ptsin:= SYSTEM.ADR (pxy);
  1292.  VDICall(11, 2, 0, 9, handle);
  1293.  VDIPB.ptsin:= oldPts;
  1294. END FilledRoundedRectangle;
  1295.  
  1296. PROCEDURE JustifiedText (handle, x, y, len, wspace, cspace: sINTEGER;
  1297.                          REF string: ARRAY OF CHAR);
  1298. VAR c, h: CARDINAL;
  1299. BEGIN
  1300.  c:= 0; h:= HIGH(string);
  1301.  (*
  1302.  SYSTEM.ASSEMBLER
  1303.    MOVEQ        #0,D0
  1304.    MOVE.W       h(A6),D1
  1305.    MOVEQ        #0,D2
  1306.    MOVE.L       string(A6),A0
  1307.    LEA          VDIIntIn,A1
  1308.    ADDA.W       #4,A1
  1309.  loop:
  1310.    MOVE.B       (A0)+,D2
  1311.    MOVE.W       D2,(A1)+
  1312.    BEQ.S        exit
  1313.    ADDQ.W       #1,D0
  1314.    SUBQ.W       #1,D1
  1315.    BNE.S        loop
  1316.   exit:
  1317.    MOVE.W       D0,c(A6)
  1318.  END;
  1319.  *)
  1320.  WHILE (c < h) OR (string[c] # 0C) DO
  1321.   VDIIntIn[c+2]:= ORD(string[c]);  INC (c);
  1322.  END;
  1323.  VDIPtsIn[0]:= x;
  1324.  VDIPtsIn[1]:= y;
  1325.  VDIPtsIn[2]:= len;
  1326.  VDIPtsIn[3]:= 0;
  1327.  VDIIntIn[0]:= wspace;
  1328.  VDIIntIn[1]:= cspace;
  1329.  VDICall(11, 2, c+2, 10, handle);
  1330. END JustifiedText;
  1331.  
  1332. VAR ptsIn,
  1333.     intIn:      SYSTEM.ADDRESS;
  1334.     control7:   POINTER TO SYSTEM.ADDRESS;
  1335.     control9:   POINTER TO SYSTEM.ADDRESS;
  1336.  
  1337. PROCEDURE CopyRasterOpaque (handle, mode: sINTEGER;
  1338.                       pxy, srcMFDB, destMFDB: ARRAY OF LOC);
  1339. BEGIN
  1340.  VDIIntIn[0]:= mode;
  1341.  ptsIn:= VDIPB.ptsin;
  1342.  VDIPB.ptsin:= SYSTEM.ADR (pxy);
  1343.  control7^:= SYSTEM.ADR (srcMFDB);
  1344.  control9^:= SYSTEM.ADR (destMFDB);
  1345.  VDICall(109, 4, 1, 0, handle);
  1346.  VDIPB.ptsin:= ptsIn;
  1347. END CopyRasterOpaque;
  1348.  
  1349. PROCEDURE CopyRasterTransparent (handle, mode, cSet, cNotset: sINTEGER;
  1350.                            pxy, srcMFDB, destMFDB: ARRAY OF LOC);
  1351. BEGIN
  1352.  VDIIntIn[0]:= mode;
  1353.  VDIIntIn[1]:= cSet;
  1354.  VDIIntIn[2]:= cNotset;
  1355.  ptsIn:= VDIPB.ptsin;
  1356.  VDIPB.ptsin:= SYSTEM.ADR (pxy);
  1357.  control7^:= SYSTEM.ADR (srcMFDB);
  1358.  control9^:= SYSTEM.ADR (destMFDB);
  1359.  VDICall(121, 4, 1, 0, handle);
  1360.  VDIPB.ptsin:= ptsIn;
  1361. END CopyRasterTransparent;
  1362.  
  1363. PROCEDURE TransformForm (handle: sINTEGER; VAR srcMFDB, destMFDB: ARRAY OF LOC);
  1364. BEGIN
  1365.  control7^:= SYSTEM.ADR (srcMFDB);
  1366.  control9^:= SYSTEM.ADR (destMFDB);
  1367.  VDICall(110, 0, 0, 0, handle);
  1368. END TransformForm;
  1369.  
  1370. PROCEDURE GetPixel (handle, x, y: sINTEGER; VAR index: sINTEGER): BOOLEAN;
  1371. BEGIN
  1372.  VDIPtsIn[0]:= x;
  1373.  VDIPtsIn[1]:= y;
  1374.  VDICall(105, 1, 0, 0, handle);
  1375.  index:= VDIIntOut[1];
  1376.  RETURN VDIIntOut[0] = 0;
  1377. END GetPixel;
  1378.  
  1379. VAR init: sINTEGER;
  1380.  
  1381. PROCEDURE InitVDI;
  1382. BEGIN
  1383.  IF init = 0 THEN
  1384.   VDIPB.control:= SYSTEM.ADR (VDIControl);
  1385.   VDIPB.intin:=   SYSTEM.ADR (VDIIntIn);
  1386.   VDIPB.ptsin:=   SYSTEM.ADR (VDIPtsIn);
  1387.   VDIPB.intout:=  SYSTEM.ADR (VDIIntOut);
  1388.   VDIPB.ptsout:=  SYSTEM.ADR (VDIPtsOut);
  1389.   vdipb:= SYSTEM.ADR (VDIPB);
  1390.   control7:= SYSTEM.ADR (VDIControl[7]);
  1391.   control9:= SYSTEM.ADR (VDIControl[9]);
  1392.   init:= 30961;
  1393.  END;
  1394. END InitVDI;
  1395.  
  1396. BEGIN
  1397.  init:= 0;  InitVDI;
  1398. END MagicVDI.
  1399.  
  1400.